Attribute VB_Name = "Module1"

'Class Cls_ClsBs
Private Temp


Public Function GetHttpPage(url)
On Error Resume Next
Dim http
Set http = CreateObject("Msxml2.XMLHTTP")
http.Open "GET", url, False
http.send
If http.ReadyState <> 4 Then Exit Function
If Err.Number = 0 Then
If http.Status = 200 Then
GetHttpPage = http.responseBody
Else
GetHttpPage = False
End If
Else
GetHttpPage = False
Err.Clear
End If
Set http = Nothing
End Function


Public Function BytesToBstr(body, Cset)
If VarType(body) <> 8209 Then
BytesToBstr = False
Else
'===================
'===================
Dim objstream
Set objstream = CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode = 3
objstream.Open
objstream.Write body
objstream.Position = 0
objstream.Type = 2
objstream.Charset = Cset
BytesToBstr = objstream.ReadText
objstream.Close
Set objstream = Nothing
End If
End Function



Public Function HttpUrls(strs, http)
HttpUrls = ""
imageurl = ""
If UCase(Left(http, 4)) <> "HTTP" Then
http = "http://" & http
End If
url2 = Split(http, "/")
i = 0
imageurl = ""
For i = 0 To 2
imageurl = imageurl & url2(i) & "/"
Next
n = 0
If UCase(Left(strs, 4)) = "HTTP" Then
HttpUrls = strs
ElseIf UCase(Left(strs, 2)) = "//" Then
HttpUrls = "http:" & strs
Else
If UCase(Left(strs, 1)) = "/" Then
url1 = Right(strs, Len(strs) - 1)
HttpUrls = imageurl & url1
ElseIf UCase(Left(strs, 3)) = "../" Then
url1 = Split(strs, "../")
If UBound(url2) - UBound(url1) >= 3 Then
strs = ""
i = 0
For i = 0 To UBound(url2) - UBound(url1) - 1
strs = strs & url2(i) & "/"
Next
strs = strs & url1(UBound(url1))
HttpUrls = strs
Else
'***
url1 = Split(strs, "/")
HttpUrls = imageurl & url1(UBound(url1))
End If
Else
imagea = ""
i = 0
For i = 0 To UBound(url2) - 1
imagea = imagea & url2(i) & "/"
Next
HttpUrls = imagea & strs
End If
End If
End Function



Public Function GetUrlenCodel(ByVal url)
Dim i, code
GetUrlenCodel = ""
If Trim(url) = "" Then Exit Function
For i = 1 To Len(url)
code = Asc(Mid(url, i, 1))
If code < 0 Then code = code + 65536
If code > 255 Then
GetUrlenCodel = GetUrlenCodel & "%" & Left(Hex(code), 2) & "%" & Right(Hex(code), 2)
Else
GetUrlenCodel = GetUrlenCodel & Mid(url, i, 1)
End If
Next
End Function



Public Function BoldWord(strContent, word, words)
BoldWord = Replace(strContent, word, words)
End Function



Public Function CreateDIR(ByVal LocalPath)
On Error Resume Next
LocalPath = LocalPath
LocalPath = Replace(LocalPath, "\", "/")
Set FileObject = CreateObject("Scripting.FileSystemObject")
patharr = Split(LocalPath, "/")
path_level = UBound(patharr)
For i = 0 To path_level
If i = 0 Then pathtmp = patharr(0) & "/" Else pathtmp = pathtmp & patharr(i) & "/"
cpath = Left(pathtmp, Len(pathtmp) - 1)
If Not FileObject.FolderExists(cpath) Then FileObject.CreateFolder cpath
Next
Set FileObject = Nothing
If Err.Number <> 0 Then
CreateDIR = False
Err.Clear
Else
CreateDIR = True
End If
End Function



Public Function Save2Local(from, tofile)
On Error Resume Next
Dim geturl, objstream, imgs
geturl = Trim(from)
imgs = GetHttpPage(geturl)
If VarType(imgs) <> 8209 Then
Save2Local = False
Else
Set objstream = CreateObject("ADODB.Stream")
objstream.Type = 1
objstream.Open
objstream.Write imgs
objstream.SaveToFile tofile, 2
objstream.Close
Set objstream = Nothing
Save2Local = True
If Err.Number <> 0 Then
Err.Clear
Save2Local = False
deletefiles (tofile)
End If
End If
End Function



Public Function deletefiles(path)
On Error Resume Next
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FileExists(path) Then
fs.DeleteFile path, True
End If
Set fs = Nothing
If Err.Number <> 0 Then Response.Write Err.Number
End Function



Public Function GenerateRandomFileName(ByVal szFilename)
Randomize
ranNum = Int(90000 * Rnd) + 10000
If Month(Now) < 10 Then c_month = "0" & Month(Now) Else c_month = Month(Now)
If Day(Now) < 10 Then c_day = "0" & Day(Now) Else c_day = Day(Now)
If Hour(Now) < 10 Then c_hour = "0" & Hour(Now) Else c_hour = Hour(Now)
If Minute(Now) < 10 Then c_minute = "0" & Minute(Now) Else c_minute = Minute(Now)
If Second(Now) < 10 Then c_second = "0" & Second(Now) Else c_second = Minute(Now)
fileExt_a = Split(szFilename, ".")
FileExt = LCase(fileExt_a(UBound(fileExt_a)))
GenerateRandomFileName = Year(Now) & c_month & c_day & c_hour & c_minute & c_second & "_" & ranNum & "." & FileExt
End Function




Public Function stripHTML(strHTML, ben, und)
SearchFile = InStrB(1, strHTML, ben, vbBinaryCompare) > 0
SearchFile1 = InStrB(1, strHTML, und, vbBinaryCompare) > 0
If SearchFile And SearchFile1 Then
pos1 = InStrB(1, strHTML, ben, vbBinaryCompare)
pos2 = InStrB(pos1, strHTML, und, vbBinaryCompare)
stripHTML = MidB(strHTML, pos1, pos2 - pos1 + LenB(und))
Else
stripHTML = False
End If
End Function



Public Function SeparateHTML(strHTML, ben, und)
SearchFile = InStrB(1, strHTML, ben, vbBinaryCompare) > 0
SearchFile1 = InStrB(1, strHTML, und, vbBinaryCompare) > 0
If SearchFile And SearchFile1 Then
pos1 = InStrB(1, strHTML, ben, vbBinaryCompare)
pos2 = InStrB(pos1 + LenB(ben), strHTML, und, vbBinaryCompare)
SeparateHTML = MidB(strHTML, pos1 + LenB(ben), pos2 - pos1 - LenB(ben))
Else
SeparateHTML = False
End If
End Function




Public Function Manhunt(webstr, Label1, Label2, IgnoreCase, Global1, Include, Stir)
Set objRegExp = New RegExp
With objRegExp
.IgnoreCase = IgnoreCase
.Global = Global1
Label1 = Replace(Label1, "(", "\(")
Label2 = Replace(Label2, ")", "\)")
.Pattern = "(" & Label1 & ").+?(" & Label2 & ")"
Set matches = .Execute(webstr)
Dim Str1
For Each Match In matches
Str1 = Str1 & Match.Value & "$url$"
Next
Set matches = Nothing
If Not Include Then
.Pattern = "(" & Label1 & ")"
Str1 = .Replace(Str1, "")
.Pattern = "(" & Label2 & ")"
Str1 = .Replace(Str1, "")
End If
If Stir Then
Str1 = Replace(Str1, """", "")
Str1 = Replace(Str1, "'", "")
End If
If Not Global1 Then
Str1 = Replace(Str1, "$url$", "")
End If
End With
Set objRegExp = Nothing
If Str1 = "" Then
Manhunt = False
Else
Manhunt = Str1
End If
End Function




Public Function RemoveHTML(fString)
Dim objRegExp
Set objRegExp = New RegExp
objRegExp.Global = True
objRegExp.IgnoreCase = True
If Not IsNull(fString) Then
objRegExp.Pattern = "<(.[^>]*)>"
fString = objRegExp.Replace(fString, "")
RemoveHTML = fString
End If
Set objRegExp = Nothing
End Function




Public Function Cen(content)
Cen = content
If content <> "" Then
Cen = Replace(Cen, Chr(13), "<br>")
Cen = Replace(Cen, Chr(32), "&nbsp;")
End If
End Function
'End Class




